home *** CD-ROM | disk | FTP | other *** search
/ Aminet 28 / Aminet 28 (1998)(GTI - Schatztruhe)[!][Dec 1998].iso / Aminet / util / shell / ShellScr.lha / ShellScr / src / ShellScr.e < prev   
Encoding:
Text File  |  1998-09-02  |  12.4 KB  |  422 lines
  1. -> ShellScr v1.5 by Kyzer/CSG
  2. -> Creates a fullscreen shell with it's own public screen
  3.  
  4. OPT PREPROCESS,OSVERSION=37
  5.  
  6. MODULE    'asl', 'diskfont', 'dos/dos', 'dos/dostags', 'exec/lists',
  7.     'exec/nodes', 'graphics/displayinfo', 'graphics/modeid',
  8.     'graphics/text', 'intuition/intuition',    'intuition/screens',
  9.     'libraries/asl', 'utility/tagitem', 'workbench/startup',
  10.     '*args', '*clr', '*defarg', '*paths'
  11.  
  12. #define DEF_CONSPEC \
  13.  'CON:\s//BACKDROP/NOBORDER/NOSIZE/NODRAG/NODEPTH/NOCLOSE/SCREEN\s'
  14.  
  15. #define DEF_CONSPEC_LEN 71
  16.  
  17. #define DEF_TITLE 'AmigaShell'
  18.  
  19.  
  20. #define TEMPLATE \
  21.  'PUBNAME=NAME,MODEID=ID,DEPTH/N,FONT/K,AUTOSCROLL/S,'+\
  22.  'SHANGHAI/S,SCREENTITLE=TITLE,NOTITLE=HIDETITLE/S,'+\
  23.  'CONSPEC=WINDOW,COMMANDFILE=FROM,STACKSIZE=STACK/N'
  24.  
  25. OBJECT myargs
  26.   pubname    -> chosen public screen name or NIL
  27.   modeid    -> string referencing mode-id or NIL
  28.   depth        -> ptr to LONG number or NIL: depth of screen
  29.   font        -> ptr to font description ('fontname/size') or NIL
  30.   autoscroll    -> boolean, true (default) = AUTOSCROLL screen
  31.   shanghai    -> boolean, true = SHANGHAI mode enabled
  32.  
  33.   title        -> string: name of titlebar or NIL
  34.   notitle    -> boolean, zero = show titlebar, non-zero = hide titlebar
  35.  
  36.   conspec    -> WINDOW parameter of NewShell
  37.   cmdfile    -> FROM parameter of NewShell
  38.  
  39.   stacksize     -> ptr to LONG number or NIL: size of stack
  40. ENDOBJECT
  41.  
  42. DEF args:myargs, sig=-1, pubname[16]:STRING
  43.  
  44.  
  45. RAISE "MEM" IF String()=NIL
  46. RAISE "SYS" IF SystemTagList()<>0
  47. RAISE "def" IF LockPubScreen()=NIL
  48. RAISE "sig" IF AllocSignal()=-1
  49.  
  50.  
  51. ->-----------------------------------------------------------------------------
  52.  
  53.  
  54. PROC main() HANDLE
  55.   DEF wbmsg:PTR TO wbstartup, rdargs=NIL, olddir, dir=NIL,
  56.       screen=NIL, command, depth=2, stack
  57.  
  58.   -> choose reasonable start directory when launched from Workbench
  59.   IF wbmsg := wbmessage
  60.     IF wbmsg.numargs > 1 THEN dir := DupLock(wbmsg.arglist[1].lock)
  61.     IF dir = NIL THEN dir := DupLock(GetProgramDir())
  62.  
  63.     IF dir THEN olddir := CurrentDir(dir)
  64.   ENDIF
  65.  
  66.   -> initialise argarray
  67.   clr(args, SIZEOF myargs)
  68.   args.pubname := StringF(pubname, 'SHELL_\z\h[8]', FindTask(NIL))
  69.   args.depth   := {depth}
  70.  
  71.   -> read arguments with fabulous wb-friendly readargs()
  72.   IF (rdargs := readargs(TEMPLATE, args, wbmsg)) = NIL THEN Raise("args")
  73.  
  74.   -> open the screen, and construct the required arguments
  75.   command := makecmd(screen := openscr())
  76.  
  77. newshell:
  78.   -> run the NewShell command to open a new command.
  79.   stack := Max(1600, IF args.stacksize THEN Long(args.stacksize) ELSE 4096)
  80.  
  81.   SystemTagList(command, NEW [
  82.     NP_PATH,       getpath(),
  83.     NP_STACKSIZE,  stack + 3 AND -4,
  84.     SYS_USERSHELL, TRUE,
  85.     TAG_DONE
  86.   ])
  87.  
  88. waitagain:
  89.   -> wait for "last-window-gone" signal
  90.   Wait(Shl(1, sig))
  91.  
  92.   -> try to close the screen
  93.   IF closescr(screen) = FALSE
  94.     -> if we fail to close the screen (user chose 'cancel'), go back
  95.     -> to waiting. But, if the screen is empty, put a shell back on it.
  96.     IF numwindows(screen) = 0 THEN JUMP newshell ELSE JUMP waitagain
  97.   ENDIF
  98.   screen := NIL
  99.  
  100. EXCEPT DO
  101.   -> Errors that deserve an error message to the user are processed here
  102.   SELECT exception
  103.  
  104.    -> couldn't allocate memory for strings or such
  105.   CASE "MEM";  msg(error(ERROR_NO_FREE_STORE))
  106.  
  107.   -> System() failed
  108.   CASE "SYS";  msg(error(0, 'Cannot open new shell'))
  109.  
  110.   -> ReadArgs() failed
  111.   CASE "args"; msg(error(0, 'Bad args'))
  112.  
  113.   -> LockPubScreen() failed
  114.   CASE "def";  msg('Cannot get a default screen')
  115.  
  116.   -> OpenScreen() failed
  117.   CASE "scr";  exceptioninfo := screenerror(exceptioninfo)
  118.                msg('Cannot open screen: \s', {exceptioninfo})
  119.   ENDSELECT
  120.  
  121.   -> cleanup
  122.  
  123.   IF screen 
  124.     REPEAT; UNTIL closescr(screen)
  125.   ENDIF
  126.  
  127.   IF dir       THEN UnLock(CurrentDir(olddir))
  128.   IF rdargs    THEN FreeArgs(rdargs)
  129.   IF sig <> -1 THEN FreeSignal(sig)
  130.  
  131. ENDPROC (IF exception THEN 10 ELSE 0)
  132.  
  133.  
  134. ->-----------------------------------------------------------------------------
  135.  
  136.  
  137. PROC closescr(s:PTR TO screen)
  138.   -> close our public screen (returns TRUE if succeeded)
  139.  
  140.   -> while we fail to close our screen, keep offering the Retry/Cancel
  141.   -> requester. If 'cancel' is chosen, return FALSE.
  142.  
  143.   WHILE CloseScreen(s) = 0 DO IF EasyRequestArgs(NIL, [20, 0, 'ShellScr',
  144.     'This screen is closing.\nPlease close all visitor windows.',
  145.     'Retry|Cancel'
  146.   ], 0, 0) = 0 THEN RETURN FALSE
  147.  
  148.   -> set default pubscreen back to Workbench.
  149.   SetDefaultPubScreen(NIL)
  150. ENDPROC TRUE
  151.  
  152.  
  153. ->-----------------------------------------------------------------------------
  154.  
  155.  
  156. PROC makecmd(s:PTR TO screen)
  157.   -> create the 'NewShell' command required to open the shell
  158.   DEF cmd, cmdformat, sizes, top
  159.  
  160.   -> window-size calculation (see guide)
  161.   top := IF args.notitle THEN 0 ELSE IF args.conspec THEN s.barheight+1 ELSE 3
  162.   sizes := StringF(String(23), '\d/\d/\d/\d', 0, top, s.width, s.height-top)
  163.  
  164.  
  165.   -> generate command formatter :  'NewShell [conspec] [FROM cmdfile]'
  166.   -> conspec contains two '%s' ('\s') formatters for windowsize and screenname
  167.   cmdformat := StringF(
  168.     String(
  169.       9 +
  170.       (IF args.conspec THEN StrLen(args.conspec)   ELSE DEF_CONSPEC_LEN) +
  171.       (IF args.cmdfile THEN StrLen(args.cmdfile)+6 ELSE 0)
  172.     ),
  173.     'NewShell \s\s\s',
  174.     defarg(args.conspec, DEF_CONSPEC),
  175.     IF args.cmdfile THEN ' FROM ' ELSE '',
  176.     defarg(args.cmdfile, '')
  177.   )
  178.  
  179.   -> create final command from format template
  180.   cmd := StringF(
  181.     String(EstrLen(cmdformat) + EstrLen(sizes) + StrLen(args.pubname)),
  182.     cmdformat, sizes, args.pubname
  183.   )
  184. ENDPROC cmd
  185.  
  186.  
  187. ->-----------------------------------------------------------------------------
  188.  
  189. PROC openscr() HANDLE
  190.   -> opens the screen as requested by the user
  191.  
  192.   DEF screen=NIL:PTR TO screen, defscreen=NIL:PTR TO screen,
  193.       drawinfo=NIL:PTR TO drawinfo, errorcode, fontdesc, font
  194.  
  195.   -> Find a default screen to read default information about
  196.   drawinfo  := GetScreenDrawInfo(defscreen := LockPubScreen(NIL))
  197.  
  198.   -> get the required font - or copy the default screen's
  199.   fontdesc, font := openfont(defscreen.font)
  200.  
  201.   screen := OpenScreenTagList(NIL, NEW [
  202.     SA_ERRORCODE,   {errorcode},
  203.  
  204.     -> tags defining the public nature of our screen
  205.     SA_PUBNAME,     args.pubname,
  206.     SA_PUBSIG,      sig := AllocSignal(-1),
  207.     SA_PUBTASK,     FindTask(NIL),
  208.     SA_TYPE,        PUBLICSCREEN,
  209.  
  210.     SA_DISPLAYID,   getmode(args.modeid, GetVPModeID(defscreen.viewport)),
  211.     SA_DEPTH,       Long(args.depth),
  212.     SA_FONT,        fontdesc,
  213.     SA_AUTOSCROLL,  args.autoscroll,
  214.  
  215.     SA_TITLE,       defarg(args.title, DEF_TITLE),
  216.     SA_SHOWTITLE,   (args.notitle = FALSE),
  217.  
  218.     SA_PENS,        IF drawinfo THEN drawinfo.pens ELSE [-1]:INT,
  219.     SA_FULLPALETTE, TRUE,
  220.  
  221.     TAG_DONE
  222.   ])
  223.  
  224.   IF screen = NIL THEN Throw("scr", errorcode)
  225.  
  226.   -> make screen go public, also make it the default pubscreen
  227.   PubScreenStatus(screen, PUBLICSCREEN)
  228.   SetDefaultPubScreen(args.pubname)
  229.  
  230.   -> enable Shanghai mode if user wants this
  231.   IF args.shanghai THEN SetPubScreenModes(SHANGHAI OR SetPubScreenModes(0))
  232.  
  233. EXCEPT DO
  234.   IF font      THEN CloseFont(font)
  235.   IF drawinfo  THEN FreeScreenDrawInfo(defscreen, drawinfo)
  236.   IF defscreen THEN UnlockPubScreen(NIL, defscreen)
  237.  
  238.   CloseLibrary(diskfontbase)
  239.   CloseLibrary(aslbase)
  240.  
  241.   ReThrow()
  242. ENDPROC screen
  243.  
  244. ->----
  245.  
  246. PROC openfont(deffont:PTR TO textattr)
  247.   DEF fontdesc=NIL:PTR TO textattr, font=NIL:PTR TO textfont, name, size
  248.  
  249.  
  250.   -> find out the real name/size of our requested (or not) font
  251.   name, size := getfont(args.font)
  252.  
  253.   -> if a certain font has been decided, then open it from disk
  254.   IF name
  255.     IF diskfontbase := OpenLibrary('diskfont.library', 37)
  256.       IF font := OpenDiskFont(fontdesc := NEW [name, size, 0, 0]:textattr)
  257.  
  258.         -> tsssk the user if he picked a proportional font
  259.         IF font.flags AND FPF_PROPORTIONAL THEN
  260.           msg('Requested font "%s/%d" is not fixed-width!', fontdesc)
  261.  
  262.       ENDIF
  263.     ENDIF
  264.   ELSE
  265.     -> only copy default font if it is fixed-width
  266.     IF (deffont.flags AND FPF_PROPORTIONAL)=0
  267.       CopyMem(deffont, NEW fontdesc, SIZEOF textattr)
  268.       fontdesc.name := StrCopy(String(StrLen(fontdesc.name)), fontdesc.name)
  269.     ENDIF
  270.   ENDIF
  271. ENDPROC fontdesc, font
  272.  
  273. ->----
  274.  
  275. PROC getfont(fontname)
  276.   -> process font-string (eg 'topaz/11', 'flyspeck', '?') and return
  277.   -> proper name and size ('topaz.font',11 or 'flyspeck.font',8 ...)
  278.  
  279.   DEF font=NIL, size=8, req:PTR TO fontrequester, valid, n
  280.  
  281.   IF fontname = NIL THEN RETURN NIL
  282.  
  283.   -> ASL font requester if fontname="?" or fontname=""
  284.   IF (StrCmp(fontname, '?') OR StrCmp(fontname, '')) AND openasl()
  285.     IF req := AllocAslRequest(ASL_FONTREQUEST, NIL)
  286.       IF AslRequest(req, [ASLFO_FIXEDWIDTHONLY, TRUE, TAG_DONE])
  287.         font := StrCopy(String(StrLen(req.attr.name)), req.attr.name)
  288.         size := req.attr.ysize
  289.       ENDIF
  290.       FreeAslRequest(req)
  291.     ENDIF
  292.   ELSE
  293.     -> copy fontname so we can (perhaps) modify it
  294.     StrCopy(font := String(StrLen(fontname)+5), fontname)
  295.  
  296.     -> look for and remove size (in 'myfont/99' format) from string
  297.     IF (n := InStr(font, '/')) <> -1
  298.       -> get size from string (or 8 as default)
  299.       size, valid := Val(font+n+1)
  300.       IF valid = FALSE THEN size := 8
  301.  
  302.       -> remove size part from string
  303.       font[n] := "\0" -> can we guarantee SetStr() to do this?
  304.       SetStr(font, n)
  305.     ENDIF
  306.  
  307.     -> add '.font' to name if neccessary
  308.     IF InStr(font, '.font') = -1 THEN StrAdd(font, '.font')
  309.   ENDIF
  310.  
  311. ENDPROC font, size
  312.  
  313. ->----
  314.  
  315. PROC getmode(modename, defmode)
  316.   -> process string with some form of mode name in it, and return a numeric ID
  317.   -> string can take the form of:
  318.   -> '' or '?' (cause user choice from ASL screenmode requester)
  319.   -> 'PAL:High Res' (named graphic mode)
  320.   -> '12345678' (decimal for compatibility with ShellScr 1.2 and previous
  321.   -> '0x29000' (hexadecimal spec with C-style number)
  322.   -> '$29000' (hexadecimal spec with asm-style number)
  323.   -> if parsing fails, it returns the default mode you supply
  324.  
  325.   DEF modeid, req:PTR TO screenmoderequester, ok, valid, dh, ni:nameinfo
  326.  
  327.   IF modename = NIL THEN RETURN defmode
  328.  
  329.   -> ASL screenmode requester when modename='?' or ''
  330.   IF (StrCmp(modename, '?') OR StrCmp(modename, '')) AND openasl()
  331.     IF req := AllocAslRequest(ASL_SCREENMODEREQUEST, NIL)
  332.       ok := AslRequest(req, [
  333.         ASLSM_DOAUTOSCROLL,       TRUE,
  334.         ASLSM_DODEPTH,            TRUE,
  335.         ASLSM_INITIALAUTOSCROLL,   args.autoscroll,
  336.         ASLSM_INITIALDISPLAYDEPTH, Long(args.depth),
  337.         ASLSM_INITIALDISPLAYID,    defmode,
  338.         TAG_DONE
  339.       ])
  340.       FreeAslRequest(req)
  341.  
  342.       IF ok = FALSE THEN Raise("canc") -> 'cancelled requester' exception
  343.  
  344.       PutLong(args.depth, req.displaydepth)
  345.       args.autoscroll := req.autoscroll
  346.  
  347.       modeid := req.displayid
  348.       msg('Chosen MODEID = 0x\h', {modeid})
  349.       RETURN modeid
  350.  
  351.     ENDIF
  352.   ENDIF
  353.  
  354.   -> compare modename against all named screenmodes in the display database
  355.  
  356.   modeid := INVALID_ID
  357.   WHILE (modeid := NextDisplayInfo(modeid)) <> INVALID_ID
  358.     IF (modeid AND MONITOR_ID_MASK)
  359.       dh := FindDisplayInfo(modeid)
  360.       IF GetDisplayInfoData(dh, ni, SIZEOF nameinfo, DTAG_NAME, INVALID_ID)
  361.         IF StrCmp(modename, ni.name) THEN RETURN modeid
  362.       ENDIF
  363.     ENDIF
  364.   ENDWHILE
  365.  
  366.   -> otherwise - a numeric ID.
  367.  
  368.   -> change '0xB1AB1A' into '$B1AB1A'
  369.   IF StrCmp(modename, '0x', 2); INC modename; modename[] := "$"; ENDIF
  370.  
  371.   -> find the value of the ID.
  372.   modeid, valid := Val(modename)
  373. ENDPROC IF valid THEN modeid ELSE defmode
  374.  
  375.  
  376. ->-----------------------------------------------------------------------------
  377. -> handy little things...
  378.  
  379. PROC screenerror(err) IS
  380.   -> sensible names for OpenScreen() errors
  381.   IF (err < 0) OR (err > 7) THEN 'Unknown error' ELSE ListItem([
  382.     'No error',
  383.     'Chosen ModeID is not available',
  384.     'Better chipset required to display this mode',
  385.     'Not enough memory',
  386.     'Not enough chip memory',
  387.     'Public name already in use',
  388.     'Unknown ModeID',
  389.     'Too many bitplanes'
  390.   ], err)
  391.  
  392.  
  393. -> count the number of windows open on a screen
  394. PROC numwindows(s:PTR TO screen)
  395.   DEF count=0, w:PTR TO window
  396.   w := s.firstwindow; WHILE w DO count++ BUT w := w.nextwindow
  397. ENDPROC count
  398.  
  399.  
  400. -> message-printer for WB and shell
  401. PROC msg(msg, args=NIL)
  402.   IF wbmessage
  403.     EasyRequestArgs(NIL, NEW [20, 0, 'ShellScr', msg, 'OK'], 0, args)
  404.   ELSE
  405.     Vprintf(msg, args); PutStr('\n')
  406.   ENDIF
  407. ENDPROC
  408.  
  409. -> returns string form of DOS Fault. Can prepend header.
  410. PROC error(error=0, header=NIL)
  411.   DEF x
  412.   SetStr(x := String((IF header THEN StrLen(header) ELSE 0) + FAULT_MAX + 2),
  413.     Fault(defarg(error, IoErr()), header, x, StrMax(x))
  414.   )
  415. ENDPROC x
  416.  
  417. -> open asl.library only once
  418. PROC openasl() IS defarg(aslbase, aslbase := OpenLibrary('asl.library', 38))
  419.  
  420. -> $VER: ShellScr.e 1.5 (02.09.98)
  421. CHAR '$VER: ShellScr 1.5 (02.09.98)',0
  422.